perm filename PLOUX.F4[RST,LCS] blob sn#085792 filedate 1974-02-05 generic text, type T, neo UTF8
	SUBROUTINE READR(NWW)
	COMMON /EDGEC/ A0,A1,A2,A3,A4,A5,A6,A7,
	1 DEBUG,T(1),XP(1),YP(1),PARMAX,
	1 HALF,FILE,RR,COH,RX,RY,CL,SL,D,B,FOUND

	DIMENSION LIST5(0/1000),LIST(6,1000)
	COMMON /LISTC/ LIST,LIST5,NEWEND,LO

	COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
	1 LSIDE,RSIDE,DTA,HYSTAB(0/15)

	DATA BITS/4/
	INTEGER FLINE,RSIDE,HYSTAB,TIM1,TIM2,FILEN,FILE,BITS
	READ(1) FILEN,RR,FLINE,LLINE,LSIDE,RSIDE,NEWEND,
	1 ((LIST(I,N),I=1,6),N=1,NEWEND)
	TYPE 202,NEWEND
	IF(NEWEND.GE.1000)RETURN
	DO 335 I=NEWEND*6+1,6000
335	LIST(I,1)=0
202	FORMAT(' NEWEND=',I4/)
	END
	SUBROUTINE PLOU(NWW)
	COMMON/PLT/JX,JY,JPL,PLT,REV,RINV,ROT,RLR,RUD,CONST,E
	1 ,JREV,JINV,KA,KB,KC,KD,RTO,JA,JB,JAR,JBR,A,IA,IB,IC,ID
C  KA-D IS FOR INVIS. INNER AREA.  IA-D IS FOR INVIS. OUTER AREA.

	COMMON/DRW/JDRW(2000)/FU/FUJ(512),JJX,RDIV,ADML
	EQUIVALENCE(JDRW,INP)
	COMMON/DDP/IDP1(4000)
	DIMENSION INP(10,200)
	COMMON/MEDGE/MC,MD,RMC,MMD/CLR/KP,KQ,KR,KS,P
	COMMON /LISTC/LIST(6,1000),LIST5(0/1000),NEWEND,LO
	COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
	1 LSIDE,RSIDE,DTA,HYSTAB(1)
	INTEGER FLINE,RSIDE
	DATA NEWX/0/,NCNT/0/,JMC/1554/,JMD/1380/
	IF(NEWEND.EQ.0)RETURN
	IF(NEWEND)GO TO 6002
	IF(NEWX)GO TO 1
	RTO=6
CC	LSIDE=6
CC	RSIDE=265
CC	FLINE=20
CC	LLINE=250
	NX=0
	NY=0

1001	FORMAT(A1,3F)
1000	FORMAT(' D, P, S, M OR T    HORZ.%,VRT.%,   ROTATION'/)
6100	FORMAT(' INNER CLEAR AREA L-R-BT-TP%  OUTER L-R-B-T%
	1   REV=1, INV=1'/)
6001	FORMAT(14F)
1	CALL JZERO
	JX=0
	JY=0
	CONST=0
	TYPE 1000
	ACCEPT 1001,WHICH,RLR,RUD,ROT
	IF(WHICH.EQ.'R')RETURN
C  TYPE 'R' TO GO BACK TO FILE TYPE-IN.
CC	IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
	NCNT=NCNT+1
	REREAD 3,(INP(NA,NCNT),NA=1,10)
	IF(WHICH.NE.'H')GO TO 8002
	TYPE 9002
	GO TO 1
9002	FORMAT(' D=DISPLAY, P=PLOT, S=SAVE FOR DRAWING PROG.'/
	1 ' M=MOVE, T=TYPE MY INPUT BACK.'/)
8002	IF(WHICH.NE.'T')GO TO 3002
6002	TYPE 91,RDIV,JJX
91	FORMAT(' CENTR=',F6.2,'   STEP=',I2)
	DO 4002 K=1,NCNT
4002	TYPE 5002,(INP(NA,K),NA=1,10)
	IF(NEWEND)RETURN
	GO TO 1000
3002	IF(WHICH.EQ.'M')GO TO 3102
	TYPE 6100
	ACCEPT 6001,A,B,C,D,E,F,G,H,REV,RINV,P,Q,R,S
C  TYPE -1 TO REPEAT LAST INPUT
	IF(A.GE.0)GO TO 33
C  REPEATS LAST INPUT
	A=AA
	B=BB
	C=CC
	D=DD
	E=EE
	F=FF
	G=GG
	H=HH
	REV=RREV
	RINV=RRINV
	P=PP
	Q=QQ
	R=RR
	S=SS
33	AA=A
	BB=B
	CC=C
	DD=D
	EE=E
	FF=F
	GG=G
	HH=H
	RREV=REV
	RRINV=RINV
	SS=S
	PP=P
	QQ=Q
	RR=R
	IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
	REREAD 3,(INP(NA,NCNT),NA=1,10)
3102	JPL=3
	WX=WHICH
C  SO IT WON'T COUNT RETRIES.
3	FORMAT(10A5)
5002	FORMAT(1X10A5)
C  FAC=SIZE BY 100'S, RLR=LEFT-RIGHT SIZE, RUD=UP-DOWN SIZE
C-- D 0 0    0,50,0,50 CLEARS LOWER LFT QUAD. 50 100 50 100 UPR RT.
C  TYPE 'T' TO GET BACK ALL INPUT LINES.
	IF(A+B+C+D.EQ.0)A=-1.
C 'N'= PLOT, BUT NO X
	IF(WHICH.NE.'S')GO TO 7002
	WHICH='P'
	CONST=-1
7002	IF(WHICH.EQ.'M')GO TO 2002
	IF(E+H+F+G.EQ.0)E=-1.
	IF(P+Q+R+S.EQ.0)P=-1.
	IF(RLR.EQ.0)RLR=100.
	IF(RUD.EQ.0)RUD=100.
	IF(ROT.EQ.1)RINV=RINV-1
2002	RLR=RLR/100.
	RUD=RUD/100.
	PLT=0
	IF(WHICH.NE.'D')GO TO 1002
C  DPY IS 1/3 SIZE OF PLOT.
	GO TO 2000

1102	IF(WHICH.NE.'M')GO TO 1
C  MOVE PEN, L-R%, U-D
2200	RX=JMC
	RY=JMD
	NX=RX*RLR
	NY=RY*RUD
	RLR=.01
	RUD=.01
	GO TO 67

1002  IF(WHICH.NE.'P')GO TO 1102
	PLT=1

2000	IF(NEWEND.GT.1000) PAUSE 'NEWEND>1000'
67	MA=0
	MB=0
	MC=(RSIDE-LSIDE)*RTO*RLR+.5
	MD=(LLINE-FLINE)*RTO*RUD+.5
	JREV=MC/JPL
	JINV=MD/JPL
	JM=-380
	KM=-200
	IF(NEWX)GO TO 655
	JMC=MC
	JMD=MD
655	JQX=NX
	JQY=NY
	IF(WHICH.EQ.'M')GO TO 671
	TYPE 657
657	FORMAT(' OUTER LIMITS')
	TYPE 65,MA,MC,MB,MD
C   OUTER COORDINATES
CC	JREV=(JA+JC)/JPL
C	JINV=(JB+JD)/JPL
	KA=0
	KB=0
	KC=0
	KD=0
	KP=0
	KQ=0
	KR=0
	KS=0
	IA=-1
	IB=99999
	IC=-1
	ID=99999
671	IF(NEWX.NE.-1)CALL DPYSET(1,IDP1,4000)
	CALL SETPOG(1)
	CALL TYPLOC(-300,-611)
	CALL DPYBRT(6)
	JX=NX/JPL
	JY=NY/JPL
	CALL AIVECT(-380,-200)
672	JA=0
	JB=0
	NC=MC/JPL
	ND=MD/JPL
	CALL DSTORT(JPL)
	CALL LINES(3)
CC	CALL JZERO
	JA=NC
	JB=0
	CALL LINES(2)
	JA=NC
	JB=ND
	CALL LINES(2)
	JB=ND
	JA=0
	CALL LINES(2)
	JA=0
	JB=0
	CALL LINES(2)
	CALL DPYOUT(1)
	IF(WHICH.NE.'M')GO TO 2683
168	NY=JQY
	NX=JQX
	GO TO 1
2683	NQ=0
	IF(A)GO TO 1683
	KA=MC*(A/100.)
	KB=MC*(B/100.)
	KC=MD*(C/100.)
	KD=MD*(D/100.)
	CALL INVIS(KA,KB,KC,KD,NQ)
1683	IF(P)GO TO 9683
	KP=MC*(P/100.)
	KQ=MC*(Q/100.)
	KR=MD*(R/100.)
	KS=MD*(S/100.)
	CALL INVIS(KP,KQ,KR,KS,NQ)
9683	IF(E)GO TO 8683
	IA=MC*(E/100.)
	IB=MC*(F/100.)
	IC=MD*(G/100.)
	ID=MD*(H/100.)
	CALL INVIS(IA,IB,IC,ID,NQ)
	IF(PLT.EQ.0)E=-1
8683	IF(PLT.NE.0)JPL=1
	KA=KA/JPL
	KB=KB/JPL
	KC=KC/JPL
	KD=KD/JPL
	KP=KP/JPL
	KQ=KQ/JPL
	KR=KR/JPL
	KS=KS/JPL
	IA=IA/JPL
	IB=IB/JPL
	IC=IC/JPL
	ID=ID/JPL
	TYPE 683
683	FORMAT(' OK?'/)
	ACCEPT 1001,NA
	IF(NA.EQ.'N')GO TO 168
	JX=NX/JPL
	JY=NY/JPL
	IF(PLT.NE.0)GO TO 1681
6852	CALL CLRPOG(2)
	CALL SETPOG(1)
CC	JA=-380
CC	JB=-200
	CALL JZERO
	CALL AIVECT(-380,-200)
	GO TO 685
50	FORMAT(' DO YOU WANT THE FRAME ?'/)
1681	TYPE 50
65	FORMAT(' LFT=',I4,'   RT=',I4,'   BOT=',I4,'   TOP=',I4)
	ACCEPT 1001,ALFAB
CC2	IF(WHICH.EQ.'N')GO TO 681
	IF(NEWX.NE.-1)CALL PLOTS(I)
681	PLT=-1
	IF(ALFAB.NE.'Y') GOTO 685
	JX=NX
	JY=NY
	JA=0
	JB=0
	CALL DSTORT(JPL)
	CALL LINES(3)
	JA=MC
	JB=0
	CALL LINES(2)
	JA=MC
	JB=MD
	CALL LINES(2)
	JA=0
	JB=MD
	CALL LINES(2)
	JA=0
	JB=0
	CALL LINES(2)
685	JAR=0
	JBR=0
	JREV=MC/JPL
	JINV=MD/JPL
	IF(CONST)PLT=-2
	CALL DSTORT(JPL)
	CALL PLTMAN
	NEWX=-1
	NX=JQX
	NY=JQY
	WX=0
	IF(PLT)CALL PLOT(0,0,3)
	NEWEND=0
	END